00100	STATE STACK LAYOUT
00200	----- ----- ------
00300	
00400	
00500			SS REGISTER		STATE STACK
00600			 ---------------	 * * * * * * * *
00700			|	|	|	|---------------|
00800			| COUNT	|SS TOP>>>>>>>>>|  →UNDO ROUTINE|
00900			|	|	|	|---------------|
01000			 ----------------	|   THINGS	|
01100						|     TO BE	|	
01200						|    RESTORED	|
01300						|---------------|
01400						|  →UNDO ROUTINE|
01500						|---------------|
01600						|   THINGS	|
01700						|     TO BE	|
01800						|    RESTORED	|
01900						|---------------|
02000						 ↓	↓      ↓
02100						 .	.      .
02200						 ↓	↓      ↓
02300			CTAG REGISTER		|---------------|
02400			 ---------------	|  →RSTR_CONTEXT|
02500			|CURRENT|BACKUP |	|---------------|
02600			|CONTEXT| MODE	|	|   SAVED TP	|
02700			|  TAG	| (0-3)	|	|---------------|
02800			 ---------------	| VIRTUAL BBASE	|
02900			CBASE REGISTER		|---------------|
03000			 ---------------	|RELATIVE PBASE	|
03100			|	|	|	|---------------|
03200			| COUNT	|SS MARK>>>>>>>>|  SAVED CBASE >>>>∨
03300			|	|	|	|---------------|  ∨
03400			 ---------------	|  SAVED CTAG	|  ∨
03500						|---------------|  ∨
03600						|FAILURE ADDRESS|  ∨
03700						|---------------|  ∨
03800						|		|  ∨
03900						 ↓   ↓  ↓  ↓   ↓   ↓
     

00100	SPECIAL LAYOUT FOR EXTENDABLE FUNCTIONS
00200	------- ------ --- ---------- ---------
00300	
00400			SS REGISTER		STATE STACK
00500			 ---------------	 * * * * * * * *
00600			|	|	|	|---------------|
00700			| COUNT	|SS TOP>>>>>>>>>|  →UNDO ROUTINE|
00800			|	|	|	|---------------|
00900			 ----------------	| THINGS TO BE	|
01000						|   RESTORED	|
01100						|---------------|
01200						 ↓	↓      ↓
01300			CTAG REGISTER		|---------------|
01400			 ---------------	|      →RSTR_DEC|<<<<<<<<
01500			|CURRENT|BACKUP |	|---------------|	∧
01600			|CONTEXT| MODE	|	|   SAVED TP	|	∧
01700			|  TAG	| (0-3)	|	|---------------|	∧
01800			 ---------------	| VIRTUAL BBASE	|	∧
01900						|---------------|	∧
02000						|RELATIVE PBASE	|	∧
02100						|---------------|	∧
02200						|  ITS  |	|	∧
02300						|CONTEXT|SS MARK>>>∨	∧
02400						|  TAG	|	|  ∨	∧
02500						|---------------|  ∨	∧
02600						 ↓	↓      ↓   ∨	∧
02700						|---------------|  ∨	∧
02800						|      →NEXT_ALT|  ∨	∧
02900						|---------------|  ∨	∧
03000						|   SAVED TP	|  ∨	∧
03100						|---------------|  ∨	∧
03200						|   VIRTUAL P	|  ∨	∧
03300						|---------------|  ∨	∧
03400						| →NEXT ALT ADDR|  ∨	∧
03500						|---------------|  ∨	∧
03600						↓	↓      ↓   ∨	∧
03700						|---------------|  ∨	∧
03800			CBASE REGISTER		|         →ERASE|  ∨	∧
03900			 --------------- 	|---------------|  ∨	∧
04000			|	|	|	|     SAVED	|<<<	∧
04100			| COUNT |SS MARK>>>>>>>>|     CBASE     |	∧
04200			|  	|       |  	|    REGISTER  >>>>∨	∧
04300			 ---------------	|---------------|  ∨	∧
04400						|   SAVED CTAG	|  ∨	∧
04500					      	|---------------|  ∨	∧
04600						|    POINTER   >>>>⊗>>>>∧
04700			 			|---------------|  ∨
04800						|		|  ∨
04900						 ↓   ↓  ↓  ↓   ↓   ↓
     

00100	ALT ROUTINE
00200	--- -------
00300	
00400		PUSHJ SS, ALT
00500		ADDR BRANCH1
00600		...
00700		ADDR BRANCHN
00800		ADDR END_ALT
00900	
01000	
01100	ALT	PUSH SS, P
01200		PUSH SS, TP
01300		PUSH SS, =NEXT_ALT
01400		JRST @ -3(SS)
01500	
01600	FAIL!	POPJ SS,
01700	
01800	NEXT_ALT
01900		MOVE TP, (SS)
02000		MOVE P, -1(SS)
02100		AOS REG1, -2(SS)
02200		AOBJN SS, (REG1)
02300	
02400	END_ALT	SUB SS, =[4,,4]
02500		POPJ SS,
02600	
02700	QUICKFAIL	(instead of FAIL when P, TP, and SS are unchanged)
02800		AOS REG1, -3(SS)
02900		JRST (REG1)		(2 INSTRUCTIONS INSTEAD OF 5)
03000	
03100	XEXPR DECISION POINTS
03200	----- -------- ------
03300	
03400	At entry, a special context is created using CREATE_ALT_CONTEXT.
03500	Its failure catcher 1(CBASE) is ERASE (explained later), which erases the
03600	decision point.  Its -2(CC) is reserved for a link to the saved stack.
03700	The context tag CT is kept on the P stack with the colon variables.
03800	
03900	At each → the stack is BLT'ed, the pointers are saved, and
04000	RESTORE_ALT_CONTEXT is pushed on top.  However, at →→ this is
04100	not done; instead, a DELETE TO CT is done.  At →choose(...),
04200	neither is done, because CHOOSE will save anyway.
     

00100	STACK BLT METHOD
00200	
00300	SAVE_CONTEXT always BLT's locations PBASE to P-1 inclusive.
00400	If P-PBASE > MAXBLT then PBASE is first moved up about half way
00500		between PBASE and P.  Two consecutive R.A.'s are found there.
00600		The stack from the lower one to P is BLT'ed, and after BLT'ing,
00700		the higher R.A. is copied just below the lower and the former
00800		contents are changed to point to the SUCCESSBLT routine.
00900	The BLT'ed stack becomes current, PBASE points to its bottom, and a
01000		"piece header" (see below) is constructed for it.
01100	
01200	
01300	VIRTUAL STACK
01400	
01500	The stack is conceptually contiguous.  If its virtual size is N and its
01600	real top is P, then its imaginary base is at P-N.  The imaginary base is
01700	stored in a cell called IMBASE.
01800	
01900	Each real stack block begins with the usual header linking it to LAST_LOGICAL
02000	and NEXT_LOGICAL.  The real block contains one or usually more stack
02100	pieces.  Each piece has a header containing:
02200	
02300		The virtual address of its zero'th word
02400		The distance from its zero'th word to its first return address
02500		The virtual address of the piece to return to on success
02600		The virtual top of this piece last time it was copied
02700	
02800	The base of the current piece is stored in PBASE and the base of the current
02900	block is stored in BLKBASE.  These are real addresses.  The virtual address
03000	of the current piece is determined by loading PBASE into an index register
03100	and then loading VIRTU(PBASE).
03200	
03300	To provide for OLD, FUNARG, and REF, there is a genuine linked list
03400	ACCESSIBLE which contains (a b c d e f), meaning that virtual addresses
03500	0 to f, e to d, c to b, and a to P-IMBASE are accessible dynamically
03600	from the current environment.  When no FUNARGS are happening, this list
03700	is NIL, meaning that all of 0 to P-IMBASE, i.e., the whole stack, is
03800	accessible.  The FETCH UUO checks ACCESSIBLE≠0; if so, it searches the
03900	stack guided by FREER links (always translating virtual to real on the
04000	way down), until a FREER link is found which points to an ACCESSIBLE
04100	range.  The VALUE stored with that FREER link is the current value of
04200	the desired variable.
     

00100	SELECT MACRO------
00200	
00300	SELECT E0 FROM I: E1 NEXT E2 UNLESS E3 IN WHICH CASE E4
00400	
00500		BEGIN
00600		BIND I TO INITIAL ;
00700		DECISION POINT L:
00800		CREATE CONTEXT ;
00900		I ← DET(IF I=INITIAL THEN E1 ELSE E2) ;
01000		RETURN	IF DET(E3) THEN ERASE ALSO E4
01100			ELSE E0 ;
01200		END
01300	
01400	
01500	FUNCTION CHOICE(INTEGER N) =
01600		SELECT I FROM I:1 ?&NEXT I+1 UNLESS I>N IN WHICH CASE FAIL ;
01700	
01800	
01900	DET(E) sets a flag checked by RSTR_DEC, NEXT_ALT, RSTR_CONTEXT,
02000	CREATE_CONTEXT, CREATE_ALT_CONTEXT, RESTORE_ALT_CONTEXT, and
02100	ALT.  If set, all of these routines error halt.  That is, E
02200	must be a deterministic expression.
02300	
02400	DET(E):
02500		AOS DETFLAG
02600		E*
02700		SOS DETFLAG
     

00100	CREATE CONTEXT = PUSHJ SS, CREATE_CONTEXT
00200		PUSH SS, CTAG		SAVE CTAG
00300		PUSH SS, CBASE		LINK TO FORMER CONTEXT
00400		MOVE CBASE, SS		MAKE CBASE POINT TO LINK
00500		ADDI CBASE, [64,,0]	DERIVE NEW CONTEXT NUMBER
00600		MOVE REG1, P		COMPUTE SAVED P + 2
00700		ADD REG1, [2,,2]
00800		SUB REG1, PBASE		COMPUTE [# WDS+1,, # WDS+1]
00900		CAMLE REG1, MAXBLT	TOO MANY?
01000		JRST RAISE_PBASE	YES
01100	OK_BASE	ADD SS, REG1		COMPUTE NEW SS
01200		JUMPG SS, EXPAND_SS	CHECK FOR STACK OVERFLOW
01300	  OK_SS HRL REG1, PBASE		LEFT HALF OF BLT CONTROL WORD
01400		HRRI REG1, 2(CBASE)	RIGHT HALF OF BLT CONTROL WORD
01500		BLT REG1, (SS)		*** BLT STACK ***
01600		PUSH SS, PBASE		SAVE PBASE
01700		PUSH SS, P		SAVE P
01800		PUSH SS, TP		SAVE TOKEN POINTER
01900		PUSH SS, =RSTR_CONTEXT	UNDO ROUTINE ADDRESS
02000		MOVEM SS, 1(CBASE)		POINTER FROM BOTTOM TO TOP
02100		JRST @-2(CBASE)		RETURN
02200	
02300	RSTR_CONTEXT:
02400		MOVE TP, (SS)		RESTORE TOKEN POINTER
02500		MOVE P, -1(SS)		RESTORE P STACK POINTER
02600		MOVE REG1, -2(SS)	PBASE
02700		MOVEM REG1, PBASE	RESTORE IT
02800		HRLI REG1, 2(CBASE)	LEFT HALF OF BLT CONTROL WORD
02900		BLT REG1, (P)		*** BLT BACK STACK ***
03000		AOBJN SS, @-2(CBASE)	REPAIR SS AND JUMP TO FAILURE LABEL
03100	
03200	ERASE CURRENT CONTEXT:
03300		CAMN SS, 1(CBASE)		SEE IF ANY SIDE EFFECTS SINCE BRANCH
03400		JRST D1			YES -- WE MUST SLIDE THEM DOWN OVER STACK COPY
03500		MOVE CBASE,(CBASE)	RESTORE CBASE
03600		MOVE CTAG, -1(CBASE)	RESTORE CTAG
03700		MOVE SS, CBASE		RESTORE SS
03800		SUB SS, =[2,,2]
03900		POPJ P,			RETURN
04000	
04100	FAIL OUT = FAIL PAST CURRENT CONTEXT = ERASE CURRENT CONTEXT ALSO FAIL:
04200		CAMN SS, 1(CBASE)		SEE IF SIDE EFFECTS TO UNDO
04300		JRST ERASE1		NO
04400		MOVEI REG1, =ERASE1	DIDDLE FAILURE ADDRESS SO IT FAILS
04500		MOVEM REG1, -2(CBASE)
04600		POPJ SS,		FAIL
04700	ERASE1	MOVE CBASE,(CBASE)
04800		MOVE CTAG, -1(CBASE)
04900		MOVE SS, CBASE
05000		SUB SS, [2,,2]
05100		POPJ SS,
     

00100	CONTEXT MANIPULATION
00200	------- ------------
00300	
00400	CREATE CONTEXT
00500		Creates a context whose initial state is the current state.
00600	
00700	DECISION POINT L:
00800		Makes L a name for the context about to be created.
00900	
01000	PUBLIC DECISION POINT L:
01100		Makes that name accessible free from other functions.
01200	
01300	FAIL
01400		Restore the initial state of the current context.
01500	
01600	FAIL {TO|THROUGH} L
01700		Erase contexts created since target and restore target.
01800	
01900	FAIL OUT
02000		FAIL THROUGH CURRENT CONTEXT
02100	
02200	ERASE
02300		Erase the current context.
02400	
02500	ERASE [FROM L1] {TO|THROUGH} L2
02600		Erase contexts.  FROM CURRENT is default.
02700	
02800	CURRENT CONTEXT, OLD(0) CONTEXT
02900	OLD CONTEXT, OLD(1) CONTEXT
03000	OLD OLD CONTEXT, OLD(2) CONTEXT
03100		Names for the current, previous, next previous contexts (etc.)
03200	
03300	SUSPEND [{TO|THROUGH} L1] [UNTIL {AT|THROUGH} L2]
03400		Save the current state and all states since the first target.
03500		Fail to that target.  If the second target is later reached,
03600		the saved states are recovered and the suspended state is restored.